perm filename CLEFXG.F4[NEW,LCS]12 blob
sn#464133 filedate 1979-07-31 generic text, type T, neo UTF8
C *** CLEFS, GETLIB
SUBROUTINE CLEFS
C**** NOW HOLDS 14 LIBE. FILES AT ONCE. *******
C**** KPNT(154) =14*11 JCLEF(4900) =14*350 NAM(14) =14*1 LIBNUM=14
C**** IF CHANGES, FIX DIMENSIONS AND DATA (LIBNUM)
DIMENSION KPNT(154),JCLEF(4900),NAM(14),RCMIN(4),CM(4)
COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS,XDIS/BM/F,G,H
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /MIN/MINI,RMINI
DATA LIBNUM/14/
DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J9,JQ(7)),
1 (R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
2,(DEG,R9,RJQ(7)),(NJR,RJQ(8)),(R3,RJQ(1)),(J8,JQ(6))
IF(R6.GE.100)R6=R6-100
C SOMETIMES MAKE SIZE +100 FOR PARTS PROGRAM.
CALL NOZERO(R6)
IF(R7.EQ.0)R7=R6
C IF P7 = 0, IT WILL EQUAL P6.
IF(JA.GT.10)GO TO 10
NAME='CLEFA'
IF(J5.LT.20)GO TO 50
R6=R6*.3
C SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
R7=R7*.3
GO TO 50
10 IF(NAME.EQ.NJR)GO TO 50
IF(NAME.EQ.0)GO TO 20
IF(NJR.EQ.0)GO TO 50
20 IF(NJR.EQ.0)GO TO 30
C TO PICK UP BASIC DRAW NAME FROM P10
NAME=NJR
GO TO 50
30 TYPE 40
40 FORMAT(' SET P10=1'/)
C LEADS TO PROPER FILE CALL
50 JTAIL=-1
IF(JA.NE.3)GO TO 60
IF(R5.NE.0.8)GO TO 60
JTAIL=0
C R5=0.8 FOR TREBLE CLEF WITH 8 ON TAIL. (FOR TENOR VOCAL)
60 NM=NAME+2*(J5/10)
C DRAW0 HAS ITEMS 0→9; DRAW1, 10→19; ETC. TO DRAW9, 90→99
JEZ=MOD(J5,10)+1
70 DO 80 KNM=1,LIBNUM
C***** LIBNUM IS NUMBER OF POSSIBLE LIBE FILES.
80 IF(NM.EQ.NAM(KNM))GO TO 110
C SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
C JUMP IF ALREADY IN CORE
NPP=0
IF(JA.NE.11)GO TO 90
C DOESN'T CHECK LOOKUP ON CLEFS AND ALPHA'S.
NPP=-1
IF(LOOKL(NM).LT.0)GO TO 100
C JUMP IF ___.LIB IS FOUND IN ,LIB AREA. DOES LOOKUP AND INIT.
IF(LOOKF(NM).LT.0)GO TO 90
CALL TYPWRD(NM)
CALL TYPSTR(' -- NOT FOUND')
CALL TYPCRLF
RETURN
90 CALL GETFI2(NM,NPP)
100 KNM=KX+1
NAM(KNM)=NM
CALL GETLIB(JCLEF,KPNT,KX)
KX=KNM
IF(KX.EQ.LIBNUM)KX=0
C**** LIBNUM IS NUMBER OF POSSIBLE LIBE FILES.
110 IF(J5.GT.3)GO TO 130
IF(JA.NE.3)GO TO 130
C 0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP) MINI→R4+100
C ↑↑↑↑↑↑↑↑ FIXUP SOMEDAY IN .DMD FILES
IF(IABS(J4).LT.80)GO TO 120
RSTJ2=.8*RSTJ2
C TO SET HGT. OF MINI CLEFS
R4=R4+CM(JEZ)
C SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
120 IF(JEZ.NE.4)GO TO 130
R4=R4+2
JEZ=3
C ABOVE IS NOW AT TOP
130 A=R4
R4=A+2.9
C ADJUSTS HEIGHT(??)
CALL CENTX
R4=A
L=KNM-1
L=KPNT(L*11+JEZ)+L*350
C NOW GET POINTER IN JCLEF ARRAY FOR THIS ITEM.
IF(L.LE.0)RETURN
C CATCHES IMPOSSIBLE NUMBERS (I HOPE!)
IF(J9.EQ.0)GO TO 150
C***** ROTATE *******
R7=R7*RSTJ2
R6=R6*RSTJ2
N=JCLEF(L)
KNT=701
C ROTATED DATA IS PUT STARTING AT LOCATION 701.(AREA FOR NM3)******
JCLEF(KNT)=N
DO 140 K=L+1,N+L-1
CALL UNPACK(J,M,JCLEF(K))
X=J*R6
Y=M*R7
JJ=JCLEF(K)/100000000
AX=ATAN2(X,Y)*57.29578
HYP=SQRT(X**2+Y**2)
ROT=DEG+AX
J=ROFF(HYP*COSD(ROT))
M=ROFF(HYP*SIND(ROT))
KNT=KNT+1
IF(J)J=1000-J
IF(M)M=1000-M
140 JCLEF(KNT)=M*10000+J+JJ*100000000
L=701
C *********** SEE AT TOP **********
R6=1.
R7=1.
RSTJ2=1.
C SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
NAM(3)=0
C WIPES OUT DATA AREA FOR NM3
C R9=P9=DEGREES OF ROTATION (0-360)
IF(KK.GT.350)KX=0
C CHECK TO SEE IF DATA WAS WIPED OUT.
150 A=-1
C FLAG FOR THICKNESS OR NO.
IF(J8.EQ.-2)GO TO 190
IF(R8.LE.0)GO TO 160
A=0
C NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
CALL THICK
C SEE CLEFZ.F4 FOR "THICK" CODE (THICK IS IN MFAIL.FAI)
GO TO 190
160 IF(IPLT)170,170,190
170 DO 180 K=L+1,JCLEF(L)+L-1
IF(JCLEF(K).LT.200000000)GO TO 180
JEZ=JCLEF(L)-1
IF(K.GT.L+1)JEZ=JEZ-K+L+1
CALL FILLMS(JEZ,JCLEF(K),R3,CENTR,R6,R7)
GO TO 190
180 CONTINUE
C FILLS ONLY WHEN PLOTING OR R8=-1
190 CALL JDRAW(JCLEF(L),R3,CENTR,RSTJ2,R6,R7)
C 3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT
IF(A)GO TO 220
IF(J8.NE.0)GO TO 200
IF(J9.EQ.0)GO TO 220
GO TO 210
200 J8=J8-1
R3=R3+XDIS
C XDIS=1 PLOTTER STEP NO MATTER WHAT SIZE FACTOR USED
210 IF(J9.EQ.0)GO TO 190
J9=J9-1
CENTR=CENTR+XDIS
GO TO 190
220 IF(JTAIL)RETURN
JTAIL=-1
JA=10
JEZ=9
C JEZ=9 MAKES AN 8 APPEAR UNDER TAIL OF TREBLE CLEF.
R6=.2
R7=R6
NM='BDR40'
R3=R3+14*RSTJ2
R4=-4
GO TO 70
END
SUBROUTINE GETLIB(JCLEF,KPNT,KX)
C GETS LIBRARY AND PUTS IT IN RIGHT SLOT
DIMENSION JCLEF(1),KPNT(1)
N=KX*11+1
C POINTER TO DIRECTORY OF EACH FINE
CALL FASTI2(KPNT(N),11)
N=KPNT(N+10)
C WORD COUNT IS IN 11TH WORD
IF(N.LE.350)GO TO 10
C CALL TYPWRD(NM)
CALL TYPSTR(' FILE TOO BIG ')
N=350
C GO ON ANYWAY
10 CALL FASTI2(JCLEF(KX*350+1),N)
END